home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / onenot / onenote.bas < prev    next >
BASIC Source File  |  1994-11-18  |  3KB  |  92 lines
  1. ' MIDI API Functions for Windows 3.1
  2. Declare Function midiOutOpen Lib "mmsystem.dll" (hMidiOut As Integer, ByVal DeviceId As Integer, ByVal C As Long, ByVal I As Long, ByVal F As Long) As Integer
  3. Declare Function midiOutShortMsg Lib "mmsystem.dll" (ByVal hMidiOut As Integer, ByVal MidiMessage As Long) As Integer
  4. Declare Function MidiOutClose Lib "mmsystem.dll" (ByVal hMidiOut As Integer) As Integer
  5.  
  6. Global midiMessageOut As Long
  7. Global midiData1 As Long
  8. Global midiData2 As Long
  9.  
  10. Global hMidiOut As Integer
  11.  
  12. ' The Volume array (velocity) used for each MIDI channel
  13. Global midiVolume(16) As Integer
  14.  
  15. ' The current Midi Channel out set on Piano form
  16. Global midiChannelOut As Integer
  17.  
  18. ' MIDI status messages
  19. Global Const NOTE_OFF = &H80
  20. Global Const NOTE_ON = &H90
  21. Global Const POLY_KEY_PRESS = &HA0
  22. Global Const CONTROLLER_CHANGE = &HB0
  23. Global Const PROGRAM_CHANGE = &HC0
  24. Global Const CHANNEL_PRESSURE = &HD0
  25. Global Const PITCH_BEND = &HE0
  26.  
  27. ' MIDI Controller Numbers Constants
  28. Global Const MOD_WHEEL = 1
  29. Global Const BREATH_CONTROLLER = 2
  30. Global Const FOOT_CONTROLLER = 4
  31. Global Const PORTAMENTO_TIME = 5
  32. Global Const MAIN_VOLUME = 7
  33. Global Const BALANCE = 8
  34. Global Const PAN = 10
  35. Global Const EXPRESS_CONTROLLER = 11
  36. Global Const DAMPER_PEDAL = 64
  37. Global Const PORTAMENTO = 65
  38. Global Const SOSTENUTO = 66
  39. Global Const SOFT_PEDAL = 67
  40. Global Const HOLD_2 = 69
  41. Global Const EXTERNAL_FX_DEPTH = 91
  42. Global Const TREMELO_DEPTH = 92
  43. Global Const CHORUS_DEPTH = 93
  44. Global Const DETUNE_DEPTH = 94
  45. Global Const PHASER_DEPTH = 95
  46. Global Const DATA_INCREMENT = 96
  47. Global Const DATA_DECREMENT = 97
  48.  
  49. 'MIDI Mapper
  50. Global Const MIDI_MAPPER = -1
  51.  
  52. ' MousePointer
  53. Global Const DEFAULT = 0
  54. Global Const HOURGLASS = 11
  55.  
  56. ' Show parameters
  57. Global Const MODAL = 1
  58. Global Const MODELESS = 0
  59.  
  60. Sub MidiOutOpenPort ()
  61.     Dim MidiOpenError As Integer
  62.     Dim Msg, Response
  63.  
  64.     ' Open MIDIOut using MIDI Mapper
  65.     MidiOpenError = midiOutOpen(hMidiOut, MIDI_MAPPER, 0, 0, 0)
  66.  
  67.     If MidiOpenError <> 0 Then
  68.     ' Put together a error message box
  69.     Msg = "The MIDI Mapper would not open.  It is either already"
  70.     Msg = Msg & " in use or not installed correctly."
  71.  
  72.     Response = MsgBox(Msg, 48, "MIDI Open Error")
  73.     End If
  74.  
  75. End Sub
  76.  
  77. Sub SendMidiOut ()
  78.     Dim MidiMessage As Long
  79.     Dim lowint As Long
  80.     Dim highint As Long
  81.     Dim x As Integer
  82.     
  83.     lowint = (midiData1 * 256) + midiMessageOut
  84.     highint = (midiData2 * 256) * 256
  85.  
  86.     MidiMessage = lowint + highint
  87.  
  88.     'Windows MIDI API function
  89.     x = midiOutShortMsg(hMidiOut, MidiMessage)
  90. End Sub
  91.  
  92.